home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectInput / Scrawl / modMain.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-08  |  4.1 KB  |  112 lines
  1. Attribute VB_Name = "modMain"
  2.  
  3. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  4. '
  5. ' Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  6. '
  7. ' File:       ModMain.bas
  8. ' Content:    Scrawl DirectInput Sample
  9. '
  10. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  11.  
  12.  
  13. ' This sample application demonstrates use of the mouse in exclusive mode and how to use
  14. ' event notification for retrieving input data.
  15. '
  16. ' Hold down the left button to draw. Click the right button or press the AppMenu key
  17. ' to bring up a context menu.
  18. '
  19. ' An important issue in using exclusive mode is being able to release and reacquire the mouse
  20. ' as needed, so that the system cursor can be used. Any exclusive-mode app is forced to release
  21. ' the mouse when the user switches to another window by Alt+Tab. In addition, Scrawl surrenders
  22. ' the mouse so that the user can navigate the context menu. Reacquisition occurs in the
  23. ' MouseMove event, which is called only when Windows has the mouse.
  24. '
  25. ' The context menu allows the user to set the mouse sensitivity, since DirectInput ignores any
  26. ' such settings in Control Panel.
  27. '
  28. ' Choosing Suspend from the menu releases the system cursor and prevents
  29. ' the application from reacquiring till the user clicks on the client area.
  30. '
  31. ' The sample also demonstrates how to subclass a window in order to intercept Windows messages
  32. ' that are not otherwise available in a Visual Basic app. In this case, we want to get the
  33. ' WM_ENTERMENULOOP message, so that we can release the mouse and get the
  34. ' system cursor when the user opens the system menu by pressing Alt+Spacebar. Note that
  35. ' subclassing can make debugging difficult. If you want to play around with this code and debug it,
  36. ' comment out the indicated line in Sub Main.
  37.  
  38.  
  39. Option Explicit
  40.  
  41. Public objDX As New DirectX8
  42. Public objDXEvent As DirectXEvent8
  43. Public objDI As DirectInput8
  44. Public objDIDev As DirectInputDevice8
  45.  
  46. Public g_cursorx As Long
  47. Public g_cursory As Long
  48. Public g_Sensitivity
  49. Public Const BufferSize = 10
  50.  
  51. Public EventHandle As Long
  52. Public Drawing As Boolean
  53. Public Suspended As Boolean
  54.  
  55. Public procOld As Long
  56.  
  57. ' Windows API declares and constants
  58.  
  59. Public Const GWL_WNDPROC = (-4)
  60. Public Const WM_ENTERMENULOOP = &H211
  61. Public Const WM_EXITMENULOOP = &H212
  62. Public Const WM_SYSCOMMAND = &H112
  63.  
  64. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  65. Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
  66. Public Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
  67. Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
  68. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  69. Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  70.  
  71. Public Type POINTAPI
  72.         x As Long
  73.         y As Long
  74. End Type
  75.  
  76.  
  77. Sub Main()
  78.  
  79.   ' Show the main form first so we can use its window handle
  80.   frmCanvas.Show
  81.  
  82.   ' Initialize our private cursor
  83.   g_cursorx = frmCanvas.ScaleWidth \ 2
  84.   g_cursory = frmCanvas.ScaleHeight \ 2
  85.   g_Sensitivity = 2
  86.   frmCanvas.mnuSpeed2.Checked = True
  87.   
  88.   ' Create DirectInput and set up the mouse
  89.   Set objDI = objDX.DirectInputCreate
  90.   Set objDIDev = objDI.CreateDevice("guid_SysMouse")
  91.   Call objDIDev.SetCommonDataFormat(DIFORMAT_MOUSE)
  92.   Call objDIDev.SetCooperativeLevel(frmCanvas.hWnd, DISCL_FOREGROUND Or DISCL_EXCLUSIVE)
  93.   
  94.   ' Set the buffer size
  95.   Dim diProp As DIPROPLONG
  96.   diProp.lHow = DIPH_DEVICE
  97.   diProp.lObj = 0
  98.   diProp.lData = BufferSize
  99.   
  100.   Call objDIDev.SetProperty("DIPROP_BUFFERSIZE", diProp)
  101.  
  102.   ' Ask for notifications
  103.   
  104.   EventHandle = objDX.CreateEvent(frmCanvas)
  105.   Call objDIDev.SetEventNotification(EventHandle)
  106.   
  107.   ' Acquire the mouse
  108.   frmCanvas.AcquireMouse
  109.   
  110. End Sub
  111.  
  112.